home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / win.tcl < prev    next >
Text File  |  1996-01-14  |  9KB  |  362 lines
  1. #== (nowrap) =================================================================
  2. #    Window handling routines. All procs are bound in AlphaBits.tcl.
  3. #=============================================================================
  4.  
  5. proc shrinkHigh {} {
  6.     global tileTop
  7.     set text [getGeometry]
  8.     set left [lindex $text 0]
  9.     set top [lindex $text 1]
  10.     set width [lindex $text 2]
  11.     sizeWin 510 150
  12.     moveWin $left $tileTop
  13. }
  14.  
  15. proc shrinkLow {} {
  16.     global tileHeight tileLeft tileTop
  17.     sizeWin 510 150
  18.     moveWin $tileLeft [expr $tileTop + $tileHeight - 150]
  19. }
  20.  
  21. proc singlePage {} {shrinkFull}
  22.  
  23. proc shrinkFull {} {
  24.     global tileTop tileHeight tileLeft
  25.     moveWin $tileLeft $tileTop
  26.     sizeWin 510 $tileHeight
  27. }
  28.  
  29. proc shrinkLeft {} {
  30.     global tileWidth tileTop tileHeight tileLeft
  31.     
  32.     set margin 4
  33.     set width [expr ($tileWidth/2)-$margin]
  34.     set text [getGeometry]
  35.     set width [expr ($tileWidth/2)-$margin]
  36.     set width [expr {$width + $margin / 2}]
  37.     moveWin $tileLeft $tileTop
  38.     sizeWin $width $tileHeight
  39. }
  40.  
  41. proc shrinkRight {} {
  42.     global tileWidth tileTop tileHeight tileLeft
  43.     
  44.     set margin 4
  45.     set width [expr ($tileWidth/2)-$margin]
  46.     set text [getGeometry]
  47.     set width [expr ($tileWidth/2)-$margin]
  48.     set width [expr {$width + $margin / 2}]
  49.     moveWin [expr $tileLeft + $width + $margin] $tileTop
  50.     sizeWin $width $tileHeight
  51. }
  52.  
  53. proc swapWithNext {} {
  54.     set files [winNames -f]
  55.     if {[llength $files] < 2} return
  56.     bringToFront [lindex $files 1]
  57. }
  58.     
  59.  
  60.  
  61. proc nextWindow {} {
  62.     global winActive 
  63.     set files [winNames -f]
  64.     if {[llength $files] < 2} {return}
  65.     set f [lindex $files 0]
  66.     set aind [lsearch $winActive $f]
  67.     if {$aind < 0} {error "No win '$f'"}
  68.     set rng [lrange $winActive 0 [expr $aind-1]]
  69.     set winActive [concat [lrange $winActive $aind end] $rng]
  70.     set winActive [lrange $winActive 1 end]
  71.     lappend winActive $f
  72.     bringToFront [lindex $winActive 0]
  73. }
  74.  
  75.  
  76. proc prevWindow {} {
  77.     global winActive 
  78.     set files [winNames -f]
  79.     if {[llength $files] < 2} {return}
  80.     set f [lindex $files 0]
  81.     set aind [lsearch $winActive $f]
  82.     if {$aind < 0} {error "No win '$f'"}
  83.     set rng [lrange $winActive 0 [expr $aind-1]]
  84.     set winActive [concat [lrange $winActive $aind end] $rng]
  85.     set f2 [lindex [lrange $winActive end end] 0]
  86.     set winActive [lreplace $winActive end end]
  87.     set winActive [linsert $winActive 0 $f2]
  88.     bringToFront $f2
  89. }
  90.  
  91. proc bufferOtherWindow {} {
  92.     global tileHeight tileTop tileWidth tileMargin
  93.     global numWinsToTile
  94.     set margin $tileMargin
  95.     set win [lindex [winNames -f] 0]
  96.     set numWins 2
  97.     set hor 2
  98.     set height [expr ($tileHeight/$numWins)-$margin]
  99.     set height [expr {$height + $margin / $numWins}]
  100.     set width $tileWidth
  101.     set ver $tileTop
  102.     
  103.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  104.     set next [nextWin]
  105.     set res [statusPrompt "Window other half ($next): " winComp]
  106.     if {![string length $res]} {
  107.         set res $next
  108.     }
  109.     
  110.     set geo [getGeometry]
  111.     if {([lindex $geo 2] != $width) || ([lindex $geo 3] != $height) || ([lindex $geo 0] != $hor) || (([lindex $geo 1] != $ver) && ([lindex $geo 1] != [expr $ver + $height + $margin]))} {
  112.         moveWin $win 1000 0
  113.         sizeWin $win $width $height
  114.         moveWin $win $hor $ver
  115.         incr ver [expr $height + $margin]
  116.     } else {
  117.         if {[lindex $geo 1] == $ver} {
  118.             incr ver [expr $height + $margin]
  119.         } 
  120.     }
  121.     
  122.     set geo [getGeometry $res]
  123.     if {([lindex $geo 0] != $hor) || ([lindex $geo 1] != $ver) || ([lindex $geo 2] != $width) || ([lindex $geo 3] != $height)} {
  124.         moveWin $res 1000 0
  125.         sizeWin $res $width $height
  126.         moveWin $res $hor $ver
  127.     }
  128.     bringToFront $res
  129. }
  130.  
  131.         
  132.     
  133.         
  134.  
  135. proc winvertically {} {
  136.     global tileHeight tileTop tileWidth tileMargin
  137.     global numWinsToTile
  138.     set margin $tileMargin
  139.     set names [winNames -f]
  140.     set numWins [llength $names]
  141.     if ($numWins<=1) return
  142.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  143.     set height [expr ($tileHeight/$numWins)-$margin]
  144.     set height [expr {$height + $margin / $numWins}]
  145.     set width $tileWidth
  146.     set ver $tileTop
  147.     if {$numWins == 0} {return}
  148.  
  149.     for {set i 0} {$i < $numWins} {incr i} {
  150.         moveWin [lindex $names $i] 1000 0
  151.         sizeWin [lindex $names $i] $width $height
  152.     }
  153.  
  154.     for {set i 0} {$i < $numWins} {incr i} {
  155.         moveWin [lindex $names $i] 2 $ver
  156.         set ver [expr $ver+$margin+$height]
  157.     }
  158. }
  159.  
  160. proc winhorizontally {} {
  161.     global tileHeight tileWidth tileTop numWinsToTile horMargin
  162.  
  163.     set names [winNames -f]
  164.     set numWins [llength $names]
  165.     if ($numWins<=1) return
  166.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  167.     set width [expr ($tileWidth/$numWins)-$horMargin]
  168.     set width [expr {$width + $horMargin / $numWins}]
  169.     set height $tileHeight
  170.     set hor 2
  171.     if {$numWins == 0} {return}
  172.  
  173.     for {set i 0} {$i < $numWins} {incr i} {
  174.         moveWin [lindex $names $i] 1000 0
  175.         sizeWin [lindex $names $i] $width $height
  176.     }
  177.  
  178.     for {set i 0} {$i < $numWins} {incr i} {
  179.         moveWin [lindex $names $i] $hor $tileTop
  180.         set hor [expr $hor+$width+$horMargin]
  181.     }
  182. }
  183.  
  184. proc wintiled {} {
  185.     global tileHeight tileWidth numWinsToTile tileTop
  186.     set xPan 8
  187.     set yPan 10
  188.     set xMarg 2
  189.     set yMarg $tileTop
  190.     set yMax 50
  191.     set names [winNames -f]
  192.     set numWins [llength $names]
  193.     if ($numWins<1) return
  194.     set line 0    
  195.     set height [expr $tileHeight-$yPan*($numWins-1)]
  196.     set width [expr $tileWidth-$xPan*($numWins-1)]
  197.     
  198.     for {set i 0} {$i < $numWins} {incr i} {
  199.         moveWin [lindex $names $i] [expr $xMarg+$i*$xPan] [expr $yMarg+$line]
  200.         set line [expr $line+$yPan]
  201.         if ($line>$yMax) {set line 0}
  202.         sizeWin [lindex $names $i] $width $height
  203.     }
  204. }
  205.  
  206.  
  207. proc winoverlay {} {
  208.     global defHeight defWidth numWinsToTile tileTop
  209.     set names [winNames -f]
  210.     set numWins [llength $names]
  211.     if ($numWins<1) return
  212.     for {set i 0} {$i < $numWins} {incr i} {
  213.         moveWin [lindex $names $i] 2 $tileTop
  214.         sizeWin [lindex $names $i] $defWidth $defHeight
  215.     }
  216. }
  217.  
  218.  
  219. proc threeQuarters {} {
  220.     global tileHeight tileWidth tileTop tileMargin
  221.  
  222.     if {[llength [set nms [winNames -f]]] <= 2} return
  223.     set one [lindex $nms 0]
  224.     set two [lindex $nms 1]
  225.     set margin $tileMargin
  226.     set height [expr ($tileHeight - $margin) / 4]
  227.  
  228.     moveWin $one 1000 0
  229.     sizeWin $one $tileWidth [expr 3 * $height]
  230.     moveWin $two 1000 0
  231.     sizeWin $two $tileWidth $height
  232.  
  233.     set ver $tileTop
  234.     moveWin $one 2 $ver
  235.     moveWin $two 2 [expr $ver + 3 * $height + $margin]
  236. }
  237. bind '3' <Q> threeQuarters
  238.  
  239.  
  240. proc chooseAWindow {} {
  241.     set name [listpick [lsort -ignore [winNames]]]
  242.     if {[string length $name]} {
  243.         bringToFront $name
  244.         if [icon -q] { icon -f $name -o }
  245.        }
  246. }
  247.  
  248.  
  249. proc nextWin {} {
  250.     global winActive 
  251.     set files [winNames -f]
  252.     if {[llength $files] < 2} {return ""}
  253.     set f [lindex $files 0]
  254.     set aind [lsearch $winActive $f]
  255.     if {$aind < 0} {error "No win '$f'"}
  256.     if {[incr aind] < [llength $winActive]} {
  257.         return [file tail [lindex $winActive $aind]]
  258.     } else {
  259.         return [file tail [lindex $winActive 0]]
  260.     }
  261. }
  262.  
  263. proc winComp {curr c} {
  264.     if {$c != "\t"} {return $c}
  265.     
  266.     set matches {}
  267.     foreach w [winNames] {
  268.         if {[string match "$curr*" $w]} {
  269.             lappend matches $w
  270.         }
  271.     }
  272.     if {![llength $matches]} {
  273.         beep
  274.     } else {
  275.         return [string range [largestPrefix $matches] [string length $curr] end]
  276.     }
  277.     return ""
  278. }
  279.  
  280. proc killWindowStatus {} {
  281.     if {[llength [winNames]] >= 2} {
  282.         set next [nextWin]
  283.         set res [statusPrompt "Kill window ($next): " winComp]
  284.     } else {
  285.         set next ""
  286.         set res [statusPrompt "Kill window: " winComp]
  287.     }
  288.  
  289.     if {[string length $res]} {
  290.         catch {bringToFront $res; killWindow}
  291.     } elseif {[string length $next]} {
  292.         catch {bringToFront $next; killWindow}
  293.     }
  294. }
  295.  
  296. proc chooseWindowStatus {} {
  297.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  298.     set next [nextWin]
  299.     set res [statusPrompt "Window ($next): " winComp]
  300.     if {[string length $res]} {
  301.         catch {bringToFront $res}
  302.     } else {
  303.         catch {bringToFront $next}
  304.     }
  305. }
  306. # bind f9 chooseWindowStatus
  307.  
  308. proc iconify {} { 
  309.     icon -t 
  310.     if {[icon -q]} {
  311.         nextWindow
  312.     }
  313. }
  314.  
  315.  
  316.  
  317. proc zoom {} {
  318.     global nzmState tileHeight tileWidth zoomedGeo tileTop tileLeft
  319.     
  320.     set win [lindex [winNames -f] 0]
  321.     if {[info exists nzmState($win)]} {
  322.         if {[getGeometry] == $zoomedGeo} {
  323.             set state $nzmState($win)
  324.             moveWin [lindex $state 0] [lindex $state 1]
  325.             sizeWin [lindex $state 2] [lindex $state 3]
  326.             unset nzmState($win)
  327.             return
  328.         }
  329.     } 
  330.  
  331.     set nzmState($win) [getGeometry]
  332.     moveWin $tileLeft $tileTop
  333.     sizeWin $tileWidth $tileHeight
  334.  
  335.     if {![info exists zoomedGeo]} {
  336.         set zoomedGeo [getGeometry]
  337.     }
  338. }
  339.  
  340. #================================================================================
  341.  
  342. proc otherThing {} {
  343.     set win [lindex [winNames -f] 0]
  344.     getWinInfo -w $win arr
  345.     if {$arr(split)} {
  346.         otherPane
  347.     } else {
  348.         swapWithNext
  349.     }
  350. }
  351.  
  352. proc winAttribute {att {win {}}} {
  353.     if {![string length $win]} {
  354.         set win [lindex [winNames -f] 0]
  355.     }
  356.     getWinInfo -w $win arr
  357.     return $arr($att)
  358. }
  359.  
  360.  
  361.  
  362.